SWAGOLX.EXE (c) 1993 GDSOFT ALL RIGHTS RESERVED 00016 SEARCH/FIND/REPLACE ROUTINES 1 05-28-9313:46ALL SWAG SUPPORT TEAM BMFIND.PAS IMPORT 27 π Hi, Andy:ππ ...Here's a demo program of the Boyer-Moore search algorithm.ππ The basic idea is to first create a Boyer-Moore index-tableπ for the string you want to search for, and then call theπ BMsearch routine. *Remember* to turn-off "range-checking"π {$R-} in your finished program, otherwise the BMSearch willπ take 3-4 times longer than it should.ππ (* Public-domain demo of Boyer-Moore search algorithm. *)π (* Guy McLoughlin - May 1, 1993. *)πprogram DemoBMSearch;ππ (* Boyer-Moore index-table data definition. *)πtypeπ BMTable = array[0..127] of byte;ππ (***** Create a Boyer-Moore index-table to search with. *)π (* *)π procedure Create_BMTable({input } Pattern : string;π {update} var BMT : BMTable);π varπ Index : byte;π beginπ fillchar(BMT, sizeof(BMT), length(Pattern));π for Index := 1 to length(Pattern) doπ BMT[ord(Pattern[Index])] := (length(Pattern) - Index)π end; (* Create_BMTable. *)ππ (***** Boyer-Moore Search function. Returns 0 if string is not *)π (* found. Returns 65,535 if BufferSize is too large. *)π (* ie: Greater than 65,520 bytes. *)π (* *)π function BMsearch({input } var Buffer;π BuffSize : word;π var BMT : BMTable;π Pattern : string) : {output} word;π varπ Buffer2 : array[1..65520] of char absolute Buffer;π Index1,π Index2,π PatSize : word;π beginπ if (BuffSize > 65520) thenπ beginπ BMsearch := $FFFF;π exitπ end;π PatSize := length(Pattern);π Index1 := PatSize;π Index2 := PatSize;π repeatπ if (Buffer2[Index1] = Pattern[Index2]) thenπ beginπ dec(Index1);π dec(Index2)π endπ elseπ beginπ if (succ(PatSize - Index2) > (BMT[ord(Buffer2[Index1])])) thenπ inc(Index1, succ(PatSize - Index2))π elseπ inc(Index1, BMT[ord(Buffer2[Index1])]);π Index2 := PatSizeπ end;π until (Index2 < 1) or (Index1 > BuffSize);π if (Index1 > BuffSize) thenπ BMsearch := 0π elseπ BMsearch := succ(Index1)π end; (* BMsearch. *)ππtypeπ arby_64K = array[1..65520] of byte;ππvarπ Index : word;π st_Temp : string[10];π Buffer : ^arby_64K;π BMT : BMTable;ππBEGINπ new(Buffer);π fillchar(Buffer^, sizeof(Buffer^), 0);π st_Temp := 'Gumby';π move(st_Temp[1], Buffer^[65516], length(st_Temp));π Create_BMTable(st_Temp, BMT);π Index := BMSearch(Buffer^, sizeof(Buffer^), BMT, st_Temp);π writeln(st_Temp, ' found at offset ', Index)πEND.π - Guyπ---π ■ DeLuxe²/386 1.25 #5060 ■π * Rose Media, Toronto, Canada : 416-733-2285π * PostLink(tm) v1.04 ROSE (#1047) : RelayNet(tm)ππ 2 05-28-9313:46ALL SWAG SUPPORT TEAM BMSEARCH.PAS IMPORT 31 { Default Compiler Directives}π{$S-,R-,V-,I-,N-,B-,F-}ππ{$IFNDEF Ver40}π {Allow overlays}π {$F+,O-,X+,A-}π{$ENDIF}ππUNIT SEARCH;ππINTERFACEππfunction SearchBuffer(var Buffer; BufLength : Word;π var Match; MatLength : Word) : Word;π {-Search through Buffer for Match. BufLength is length of range to search.π MatLength is length of string to match. Returns number of bytes searchedπ to find Match, $FFFF if not found.}ππIMPLEMENTATIONππ function SearchBuffer(var Buffer; BufLength : Word;π var Match; MatLength : Word) : Word;π {-Search through Buffer for Match. BufLength is length of range to search.π MatLength is length of string to match. Returns number of bytes searchedπ to find Match, $FFFF if not found.}π beginπ inline(π $1E/ {PUSH DS ;Save DS}π $FC/ {CLD ;Go forward}π $C4/$7E/<Buffer/ {LES DI,[BP+<Buffer] ;ES:DI => Buffer}π $89/$FB/ {MOV BX,DI ;BX = Ofs(Buffer)}π $8B/$4E/<BufLength/ {MOV CX,[BP+<BufLength] ;CX = Length of range to scan}π $8B/$56/<MatLength/ {MOV DX,[BP+<MatLength] ;DX = Length of match string}π $85/$D2/ {TEST DX,DX ;Length(Match) = 0?}π $74/$24/ {JZ Error ;If so, we're done}π $C5/$76/<Match/ {LDS SI,[BP+<Match] ;DS:SI => Match buffer}π $AC/ {LODSB ;AL = Match[1]; DS:SI => Match[2]}π $4A/ {DEC DX ;DX = MatLength-1}π $29/$D1/ {SUB CX,DX ;CX = BufLength-(MatLength-1)}π $76/$1B/ {JBE Error ;Error if BufLength is less}π {;Search for first character in Match}π {Next:}π $F2/$AE/ {REPNE SCASB ;Search forward for Match[1]}π $75/$17/ {JNE Error ;Done if not found}π $85/$D2/ {TEST DX,DX ;If Length = 1 (DX = 0) ...}π $74/$0C/ {JZ Found ; the "string" was found}π {;Search for remainder of Match}π $51/ {PUSH CX ;Save CX}π $57/ {PUSH DI ;Save DI}π $56/ {PUSH SI ;Save SI}π $89/$D1/ {MOV CX,DX ;CX = Length(Match) - 1}π $F3/$A6/ {REPE CMPSB ;Does rest of string match?}π $5E/ {POP SI ;Restore SI}π $5F/ {POP DI ;Restore DI}π $59/ {POP CX ;Restore CX}π $75/$EC/ {JNE Next ;Try again if no match}π {;Calculate number of bytes searched and return}π {Found:}π $4F/ {DEC DI ;DX = Offset where found}π $89/$F8/ {MOV AX,DI ;AX = Offset where found}π $29/$D8/ {SUB AX,BX ;Subtract starting offset}π $EB/$03/ {JMP SHORT SDone ;Done}π {;Match was not found}π {Error:}π $31/$C0/ {XOR AX,AX ;Return $FFFF}π $48/ {DEC AX}π {SDone:}π $1F/ {POP DS ;Restore DS}π $89/$46/<SearchBuffer); {MOV [BP+<Search],AX ;Set func result}π end;ππEND. 3 05-28-9313:46ALL SWAG SUPPORT TEAM BMSRCH.PAS IMPORT 30 {$A+,B-,D-,E+,F-,I-,L-,N-,O-,R-,S-,V-}πUnit BMSrch;ππInterfaceππTypeπ Btable = Array[0..255] of Byte;ππProcedure BMMakeTable(Var s; Var t : Btable);πFunction BMSearch(Var buff; size : Word; Bt: Btable; Var st): Word;πFunction BMSearchUC(Var buff; size : Word; Bt: Btable; Var st): Word;ππImplementationππProcedure BMMakeTable(Var s; Var t : Btable);π { Makes a Boyer-Moore search table. s = the search String t = the table }π Varπ st : Btable Absolute s;π slen: Byte Absolute s;π x : Byte;π beginπ FillChar(t,sizeof(t),slen);π For x := slen downto 1 doπ if (t[st[x]] = slen) thenπ t[st[x]] := slen - xπ end;ππFunction BMSearch(Var buff; size : Word; Bt: Btable; Var st): Word;π { Not quite a standard Boyer-Moore algorithm search routine }π { To use: pass buff as a dereferenced Pointer to the buffer}π { st is the String being searched For }π { size is the size of the buffer }π { If st is not found, returns $ffff }π Varπ buffer : Array[0..65519] of Byte Absolute buff;π s : Array[0..255] of Byte Absolute st;π len : Byte Absolute st;π s1 : String Absolute st;π s2 : String;π numb,π x : Word;π found : Boolean;π beginπ s2[0] := chr(len); { sets the length to that of the search String }π found := False; π numb := pred(len);π While (not found) and (numb < (size - len)) do beginπ if buffer[numb] = ord(s1[len]) then { partial match } beginπ if buffer[numb-pred(len)] = ord(s1[1]) then { less partial! } beginπ move(buffer[numb-pred(len)],s2[1],len);π found := s1 = s2; { if = it is a complete match }π BMSearch := numb - pred(len); { will stick unless not found }π end;π inc(numb); { bump by one Char - match is irrelevant }π endπ elseπ inc(numb,Bt[buffer[numb]]);π end;π if not found thenπ BMSearch := $ffff;π end; { BMSearch }ππ πFunction BMSearchUC(Var buff; size : Word; Bt: Btable; Var st): Word;π { Not quite a standard Boyer-Moore algorithm search routine }π { To use: pass buff as a dereferenced Pointer to the buffer}π { st is the String being searched For }π { size is the size of the buffer }π { If st is not found, returns $ffff }π Varπ buffer : Array[0..65519] of Byte Absolute buff;π chbuff : Array[0..65519] of Char Absolute buff;π s : Array[0..255] of Byte Absolute st;π len : Byte Absolute st;π s1 : String Absolute st;π s2 : String;π numb,π x : Word;π found : Boolean;π beginπ s2[0] := chr(len); { sets the length to that of the search String }π found := False; π numb := pred(len);π While (not found) and (numb < (size - len)) do beginπ if UpCase(chbuff[numb]) = s1[len] then { partial match } beginπ if UpCase(chbuff[numb-pred(len)]) = s1[1] then { less partial! } beginπ move(buffer[numb-pred(len)],s2[1],len);π For x := 1 to length(s2) doπ s2[x] := UpCase(s2[x]);π found := s1 = s2; { if = it is a complete match }π BMSearchUC := numb - pred(len); { will stick unless not found }π end;π inc(numb); { bump by one Char - match is irrelevant }π endπ elseπ inc(numb,Bt[ord(UpCase(chbuff[numb]))]);π end;π if not found thenπ BMSearchUC := $ffff;π end; { BMSearchUC }ππend.π 4 05-28-9313:46ALL SWAG SUPPORT TEAM BOYER.PAS IMPORT 29 π (* Public-domain demo of Boyer-Moore search algorithm. *)π (* Guy McLoughlin - May 2, 1993. *)πprogram DemoBMSearch;πππ (* Boyer-Moore index-table data definition. *)πtypeπ BMTable = array[0..255] of byte;πππ (***** Create a Boyer-Moore index-table to search with. *)π (* *)π procedure Create_BMTable({output} var BMT : BMTable;π {input } Pattern : string;π ExactCase : boolean);π varπ Index : byte;π beginπ fillchar(BMT, sizeof(BMT), length(Pattern));π if NOT ExactCase thenπ for Index := 1 to length(Pattern) doπ Pattern[Index] := upcase(Pattern[Index]);π for Index := 1 to length(Pattern) doπ BMT[ord(Pattern[Index])] := (length(Pattern) - Index)π end; (* Create_BMTable. *)πππ (***** Boyer-Moore Search function. Returns 0 if string is not *)π (* found. Returns 65,535 if BufferSize is too large. *)π (* ie: Greater than 65,520 bytes. *)π (* *)π function BMsearch({input } var BMT : BMTable;π var Buffer;π BuffSize : word;π Pattern : string;π ExactCase : boolean) : {output} word;π varπ Buffer2 : array[1..65520] of char absolute Buffer;π Index1,π Index2,π PatSize : word;π beginπ if (BuffSize > 65520) thenπ beginπ BMsearch := $FFFF;π exitπ end;π PatSize := length(Pattern);π if NOT ExactCase thenπ beginπ for Index1 := 1 to BuffSize doπ if (Buffer2[Index1] > #96)π and (Buffer2[Index1] < #123) thenπ dec(Buffer2[Index1], 32);π for Index1 := 1 to length(Pattern) doπ Pattern[Index1] := upcase(Pattern[Index1])π end;π Index1 := PatSize;π Index2 := PatSize;π repeatπ if (Buffer2[Index1] = Pattern[Index2]) thenπ beginπ dec(Index1);π dec(Index2)π endπ elseπ beginπ if (succ(PatSize - Index2) > (BMT[ord(Buffer2[Index1])])) thenπ inc(Index1, succ(PatSize - Index2))π elseπ inc(Index1, BMT[ord(Buffer2[Index1])]);π Index2 := PatSizeπ end;π until (Index2 < 1) or (Index1 > BuffSize);π if (Index1 > BuffSize) thenπ BMsearch := 0π elseπ BMsearch := succ(Index1)π end; (* BMsearch. *)ππtypeπ arby_64K = array[1..65520] of byte;ππvarπ Index : word;π st_Temp : string[20];π Buffer : ^arby_64K;π BMT : BMTable;ππBEGINπ new(Buffer);π fillchar(Buffer^, sizeof(Buffer^), 0);π st_Temp := 'aBcDeFgHiJkLmNoPqRsT';π move(st_Temp[1], Buffer^[65501], length(st_Temp));π st_Temp := 'AbCdEfGhIjKlMnOpQrSt';π Create_BMTable(BMT, st_Temp, false);π Index := BMSearch(BMT, Buffer^, sizeof(Buffer^), st_Temp, false);π writeln(st_Temp, ' found at offset ', Index)πEND.π - Guyπ---π ■ DeLuxe²/386 1.25 #5060 ■π * Rose Media, Toronto, Canada : 416-733-2285π * PostLink(tm) v1.04 ROSE (#1047) : RelayNet(tm)ππ 5 05-28-9313:46ALL SWAG SUPPORT TEAM CHGE.PAS IMPORT 103 Program Chge;ππ{ Copyright 1990 Trevor J Carlsen Version 1.06 24-07-90 }π{ This Program may be used and distributed as if it was in the Public Domain}π{ With the following exceptions: }π{ 1. If you alter it in any way, the copyright notice must not be }π{ changed. }π{ 2. If you use code excerpts in your own Programs, due credit must be }π{ given, along With a copyright notice - }π{ "Parts Copyright 1990 Trevor J Carlsen" }π{ 3. No Charge may be made For any Program using code from this Program.}ππ{ Changes (or deletes) a String in any File. If an .EXE or .COM File then }π{ the change must be of a similar length inorder to retain the executable }π{ integrity. }ππ{ If you find this Program useful here is the author's contact address - }ππ{ Trevor J Carlsen }π{ PO Box 568 }π{ Port Hedland Western Australia 6721 }π{ Voice 61 [0]91 72 2026 }π{ Data 61 [0]91 72 2569 }ππUsesπ BmSrch,π Dos;ππConstπ space = #32;π quote = #34;π comma = #44;π copyright1 = 'CHGE - version 1.06 Copyright 1989,1990 Trevor Carlsen';π copyright2 = 'All rights reserved.';ππVarπ dirinfo : SearchRec; { Dos }π f : File;π FDir : DirStr; { Dos }π mask,π fname,π oldstr,π newstr : String;π oldlen : Byte Absolute oldstr;π newlen : Byte Absolute newstr;π changes : Word;π time : LongInt Absolute $0000:$046C;π start : LongInt;ππFunction ElapsedTime(start : LongInt): Real;π beginπ ElapsedTime := (time - start) / 18.2;π end; { ElapsedTime }ππProcedure ReportError(e : Byte);πbeginπ Writeln('CHGE [path]Filename searchstr replacementstr|NUL');π Writeln(' eg: CHGE c:\autoexec.bat "color" "colour"');π Writeln(' CHGE c:\autoexec.bat 12 13,10,13,10,13,10,13,10');π Writeln(' CHGE c:\wp\test.txt "Trevor" NUL');π Writeln;π Writeln('The first example will change every occurrence of the Word "color" to "colour"');π Writeln('The second will replace every formfeed Character (ascii 12) With 4 sets of');π Writeln('carriage return/linefeed combinations and the third will delete every');π Writeln('occurrence of "Trevor"');π Writeln('The prime requirements are:');π Writeln(' There MUST always be exactly three space delimiters on the command line -');π Writeln(' one between the Program name and the Filename, one between the Filename and');π Writeln(' the search String and another between the search String and the replacement');π Writeln(' String. Any other spaces may ONLY occur between quote Characters.');π Writeln(' The Program will not permit you to change the length of an .EXE or .COM File,');π Writeln(' therefore the replacement String MUST be the same length as the String');π Writeln(' that it is replacing in these cases.');π Writeln;π Writeln(' If using ascii codes, each ascii Character must be separated from another');π Writeln(' by a comma. The same rule applies to spaces as above - three required - no');π Writeln(' more - no less. If just deleting the NUL must not be in quotes.');π halt(e);πend; { ReportError }ππFunction StUpCase(Str : String) : String;πVarπ Count : Integer;πbeginπ For Count := 1 to Length(Str) doπ Str[Count] := UpCase(Str[Count]);π StUpCase := Str;πend;ππProcedure ParseCommandLine;πVarπ parstr, { contains the command line }π temp : String;π len : Byte Absolute parstr; { the length Byte For parstr }π tlen : Byte Absolute temp; { the length Byte For temp }π CommaPos,π QuotePos,π SpacePos,π chval : Byte;π error : Integer;π DName : NameStr;π DExt : ExtStr;ππ Function right(Var s; n : Byte): String;{ Returns the n right portion of s }π Varπ st : String Absolute s;π len: Byte Absolute s;π beginπ if n >= len thenπ right := stπ elseπ right := copy(st,succ(len)-n,n);π end; { right }ππbeginπ parstr := String(ptr(PrefixSeg,$80)^); { Get the command line }π if parstr[1] = space thenπ delete(parstr,1,1); { First Character is usually a space }π SpacePos := pos(space,parstr);π if SpacePos = 0 then { No spaces }π ReportError(1);π mask := StUpCase(copy(parstr,1,pred(SpacePos)));π FSplit(mask,Fdir,DName,DExt); { To enable the directory to be kept }π delete(parstr,1,SpacePos);π QuotePos := pos(quote,parstr);π if QuotePos <> 0 then begin { quotes - so must be quoted Text }π if parstr[1] <> quote then { so first Char must be quote }π ReportError(2);π delete(parstr,1,1); { get rid of the first quote }π QuotePos := pos(quote,parstr); { and find the next quote }ππ if QuotePos = 0 then { no more - so it is an error }π ReportError(3);π oldstr := copy(parstr,1,pred(QuotePos));{ search String now defined }π if parstr[QuotePos+1] <> space then { must be space between }π ReportError(1);π delete(parstr,1,succ(QuotePos)); { the quotes - else error }π if parstr[1] <> quote then begin { may be a delete }π tlen := 3;π move(parstr[1],temp[1],3);π if temp <> 'NUL' then { is not a delete }π ReportError(4) { must be quote after space or NUL }π elseπ newlen := 0; { is a delete - so nul the replacement }π endπ else beginπ delete(parstr,1,1); { get rid of the quote }π QuotePos := pos(quote,parstr); { find next quote For end of String }π if QuotePos = 0 then { None? - then error }π ReportError(5);π newstr := copy(parstr,1,pred(QuotePos));{ Replacement String defined }π end;π endπ else begin { must be using ascii codes }π oldlen := 0;π SpacePos := pos(space,parstr); { Find end of search Characters }π if SpacePos = 0 then { No space - so error }π ReportError(6);π temp := copy(parstr,1,SpacePos-1);π delete(parstr,1,SpacePos); { get rid of the search Characters }π CommaPos := pos(comma,temp); { find first comma }π if CommaPos = 0 then { No comma - so only one ascii code }π CommaPos := succ(tlen);π Repeat { create the search String }π val(copy(temp,1,CommaPos-1),chval,error); { convert to a numeral and }π if error <> 0 then { if there is an error bomb out }π ReportError(7);π inc(oldlen);π oldstr[oldlen] := Char(chval);{ add latest Char to the search String }π delete(temp,1,CommaPos);π CommaPos := pos(comma,temp);π if CommaPos = 0 thenπ CommaPos := succ(tlen);π Until tlen = 0;π newlen := 0;π CommaPos := pos(comma,parstr);π if CommaPos = 0 thenπ CommaPos := succ(len);π Repeat { create the replacement String }π val(copy(parstr,1,pred(CommaPos)),chval,error);π if error <> 0 then { must be ascii code }π ReportError(8);π inc(newlen);π newstr[newlen] := Char(chval);π delete(parstr,1,CommaPos);π CommaPos := pos(comma,parstr);π if CommaPos = 0 then CommaPos := len+1;π Until len = 0;π end; { else }π if ((right(mask,3) = 'COM') or (right(mask,3) = 'EXE')) andπ (newlen <> oldlen) thenπ ReportError(16);πend; { ParseCommandLine }ππFunction OpenFile(fn : String): Boolean;π beginπ assign(f,fn);π {$I-} reset(f,1); {$I+}π OpenFile := IOResult = 0;π end; { OpenFile }ππProcedure CloseFile;π beginπ {$I-}π truncate(f);π Close(f);π if IOResult <> 0 then; { dummy call to IOResult }π {$I+}π end; { CloseFile }ππProcedure ChangeFile(Var chge : Word);π Constπ bufflen = 65000; { This is the limit For BMSearch }π searchlen = bufflen - 1000; { Allow space For extra Characters in }π Type { the replacement String }π buffer = Array[0..pred(bufflen)] of Byte;π buffptr = ^buffer;π Varπ table : BTable; { Boyer-Moore search table }π old, { Pointer to old buffer }π nu : buffptr; { Pointer to new buffer }π count,π result,π oldpos,π newpos : Word;π oldfpos,π newfpos : LongInt;π finished : Boolean;ππ Procedure AllocateMemory(Var p; size : Word);π Varπ buff : Pointer Absolute p;π beginπ if MaxAvail >= size thenπ GetMem(buff,size)π else beginπ Writeln('Insufficient memory available.');π halt(10);π end;π end; { AllocateMemory }ππ beginπ oldfpos := 0; newfpos := 0;π chge := 0;π AllocateMemory(old,searchlen);π AllocateMemory(nu,bufflen); { make room on the heap For the buffers }π BMMakeTable(oldstr,table); { Create a Boyer-Moore search table }π {$I-}π BlockRead(f,old^,searchlen,result); { Fill old buffer }π oldfpos := FilePos(f);π {$I+}π if IOResult <> 0 then beginπ CloseFile; ReportError(11);π end;π Repeatπ oldpos := 0; newpos := 0; count := 0;π finished := (result < searchlen); { if buffer<>full then no more reads }π Repeat { Do a BM search For search String }π count := BMSearch(old^[oldpos],result-oldpos,table,oldstr);π if count = $FFFF then begin { search String not found so copy rest }π move(old^[oldpos],nu^[newpos],result-oldpos); { of buffer to new }π inc(newpos,result-oldpos); { buffer and update the buffer markers }π inc(oldpos,result-oldpos);π endπ else begin { search String found }π if count <> 0 then begin { not at position one in the buffer }π move(old^[oldpos],nu^[newpos],count);{ transfer everything prior }π inc(oldpos,count); { to the search String to new buffer }π inc(newpos,count); { and update the buffer markers }π end;π move(newstr[1],nu^[newpos],newlen); { copy the replacement String }π inc(oldpos,oldlen); { to the new buffer and update the buffer }π inc(newpos,newlen); { markers }π inc(chge);π end;π Until oldpos >= result; { keep going Until end of buffer }π if not finished then begin { Fill 'er up again For another round }π {$I-}π seek(f,oldfpos);π BlockRead(f,old^,searchlen,result);π oldfpos := FilePos(f);π {$I+}π if IOResult <> 0 then beginπ CloseFile; ReportError(13);π end; { if IOResult }π end; { if not finished }π {$I-}π seek(f,newfpos);π BlockWrite(f,nu^,newpos); { Write new buffer to File }π newfpos := FilePos(f);π {$I+}π if IOResult <> 0 then beginπ CloseFile; ReportError(12);π end;π Until finished;π FreeMem(old, searchlen); FreeMem(nu,bufflen);π end; { ChangeFiles }ππProcedure Find_and_change_all_Files;π Varπ Filefound : Boolean;ππ Function padstr(ch : Char; len : Byte): String;π π Varπ temp : String;π π beginπ FillChar(temp[1],len,ch);π temp[0] := chr(len);π padstr := temp;π end; { padstr }ππ beginπ Filefound := False;π FindFirst(mask,AnyFile,dirinfo);π While DosError = 0 do beginπ Filefound := True;π start := time;π fname := FDir + dirinfo.name;π if OpenFile(fname) then beginπ Write(fname,PadStr(space,30-length(fname)),FileSize(f):7,' ');π ChangeFile(changes);π CloseFile;π if changes = 0 thenπ Writelnπ elseπ Writeln('Made ',changes,' changes in ',ElapsedTime(start):4:2,' seconds.')π endπ elseπ Writeln('Unable to process ',fname);π FindNext(dirinfo);π end; { While DosError = 0 }π if not Filefound thenπ Writeln('No Files found.');π end; { Find_and_change_all_Files }ππbegin { main }π Writeln(copyright1);π Writeln(copyright2);π ParseCommandLine;π Find_and_change_all_Files;πend.ππ 6 05-28-9313:46ALL SWAG SUPPORT TEAM FINDDATA.PAS IMPORT 11 { Following is some code I've thrown together <!>, which has to find aπsequence of 4 Characters in a large buffer - non-Text data. The bufferπis 4096 Characters, and the sequence(s) I'm searching For could beπanywhere in it, and may be found numerous times. I suspect this code isπpretty inefficient, but I can't think of anything better. (Yep, this isπto work With the ZIP directory at the end of the File...)π So, I'm looking For a better way to code this process. I know thatπPos won't work, so this brute-Force is what I came up with. Anythingπbetter? Thanks...π}πConst CFHS : String[4] = 'PK'#01#02; { CENTRAL_File_HEADER_SIGNATURE }π ECDS : String[4] = 'PK'#05#06; { end_CENTRAL_DIRECtoRY_SIGNATURE }πVar S4 : String[4];π FOUND : Boolean;π QUIT : Boolean; { "end" sentinel encountered }πbeginπ FETCH_NAME; Assign (F,F1); Reset (F,1); C := 1; HSize := 0;π FSize := FileSize(F);π I := FSize-BSize; { Compute point to start read }π Seek (F,I); BlockRead (F,BUFF,BSize,RES); { ZIP central directory }π S4[0] := #4; C := 0;π Repeatπ FOUND := False; { search For CENTRAL_File_HEADER_SIGNATURE }π Repeatπ Inc (C); Move (BUFF[C],S4[1],4); FOUND := S4 = CFHS;π QUIT := S4 = ECDS;π Until FOUND or QUIT;πend. 7 05-28-9313:46ALL SWAG SUPPORT TEAM FINDDUPL.PAS IMPORT 23 {πTRAVIS GRIGGSππ> I have one question For you in return: could you send the currentπ> source code of your Program, or could you otherwise describe whatπ> your input Text File Characterizations are (how big can the File be,π> how long can the lines be, do you scan each line, or only taglines,ππHere's the code. Don't worry about the structure of it. I know it is bad butπthis was a quick and dirty little util I wrote up that I needed. Have fun Withπit and try to speed it up. And whoever else wants to help have fun!ππI hope this compiles I took out some stuff that would display a little pictureπof a sWord and show the version and product name. I also tried DJ's idea ofπthe buffer of 65535 but it said the structure was too large. So I used 64512.π}πUses Crt;πTypeπ BBT = Array[0..64512] of Char;ππVarπ BUFF : ^BBT;π TheFile,π logFile : Text;π Looking,π TempStr : String[80];π Numoflines,π F, J, Point : LongInt;π Divi, Multi : Real;ππProcedure Stop;πbeginπ Close(TheFile);π Close(LogFile);π Halt(1);πend;ππProcedure CommandError(Err: Byte);πbeginπ TextColor(10);π Case Err Ofπ 2 : WriteLn('You must specify a File on the command line.');π 3 : WriteLn('Can''t find "', ParamStr(1),'"');π 4 : WriteLn('Too many open Files to open ', ParamStr(1));π 5 : WriteLn('Error in reading ', ParamStr(1));π end; { end total Case }π WriteLn;π Halt(1);πend; { end Procedure }ππbeginπ if Paramcount < 1 Thenπ CommandError(2);π ClrScr;π Assign(TheFile,ParamStr(1));π New(BUFF);π SetTextBuf(TheFile,BUFF^);π Assign(LogFile,'FINDDUPE.LOG');π ReWrite(LogFile);π Reset(TheFile);π Case IoResult Ofπ 2 : CommandError(3);π 4 : CommandError(4);π 3,5..162 : CommandError(5);π end;π While not EOF(TheFile) Doπ beginπ Readln(TheFile);π Inc(Numoflines);π end;π Writeln('There are ',Numoflines,' lines in this File.');π Writeln;π Writeln('Duplicate lines are being written to FINDDUPE.LOG');π Writeln;π Writeln('Press any key to stop the search For duplicate lines');π Point := 0;π Reset(TheFile);π While Point <> Numoflines Doπ beginπ GotoXY(1, 7);π if Point <> 0 Thenπ beginπ Divi := Point / Numoflines;π Multi := Divi * 100;π WriteLn(Multi : 3 : 2, '% Completed');π end;π Reset(TheFile);π if Point <> 0 Thenπ For J := 1 to Point Doπ Readln(TheFile);π Readln(TheFile,Looking);π Reset(TheFile);π Inc(Point);π For F := 1 to Numoflines Doπ beginπ if KeyPressed thenπ Stop;π Readln(TheFile, TempStr);π if (Point <> F) and (TempStr = Looking) Thenπ Writeln(LogFile,Looking);π end;π end;π GotoXY(1, 7);π Writeln('100.00% Completed');π Close(TheFile);π Close(LogFile);πend.π 8 05-28-9313:46ALL SWAG SUPPORT TEAM FINDTEXT.PAS IMPORT 11 {π> I need help on making a Search Procedure in TURBO PASCAL.π> what I want it to do is to open the contents in a Text Fileπ> search For a given String. and diplay that Record or line With thatπ> given String!!!ππHere is a Program that will search a Text File and display the linesπof Text With the search String in it.π}ππProgram Search;πTypeπ BigString = String[132];πVarπ FileName: String[14];π FileVar: Text;π LineNumber: Integer;π OneLine, Temporary, SubString: BigString;ππ{ Make all Chars in S upper case}πProcedure UpperCase(Var S: BigString);πVarπ I: Integer;πbeginπ For I := 1 to Length(S) doπ S[I] := Upcase(S[I]);πend;ππbeginπ Write('Search what Text File? ');π Readln(FileName);π Assign(FileVar, FileName);π Repeatπ Writeln;π Reset(FileVar);π Write('Search for? (Enter to quit) ');π Readln(SubString);π if Length(SubString) > 0 thenπ beginπ UpperCase(SubString);π LineNumber := 0;π While not Eof(FileVar) doπ beginπ Readln(FileVar, OneLine);π Inc(LineNumber);π Temporary := OneLine;π UpperCase(Temporary);π if Pos(SubString, Temporary) >0π Then Writeln(LineNumber:3, ': ', OneLine)π endπ endπ Until Length(SubString) = 0πend.π 9 05-28-9313:46ALL SWAG SUPPORT TEAM NEXTCHAR.PAS IMPORT 13 {πDuncan Murdochππ>varπ> TextFile: Text;π> NextChar: Char;π>...π>beginπ>...π> with TextRec(TextFile) do NextChar:= Buffer[BufPos];ππCareful! This is unreliable, because the Buffer could be empty. You shouldπcheck that there's something there, and fill it if not.ππHere's my NextChar routine. BTW, I don't like the DOS unit's declaration ofπTextRec, so I wrote my own.π}ππtypeπ IOFunc = function(var Source:text): Integer;π TTextBuf = array[0..127] of char;π PTextBuf = ^TTextBuf;π TextRec = recordπ Handle: Word;π Mode: Word;π BufSize: Word;π Private: Word;π BufPos: Word;π BufEnd: Word;π BufPtr: PTextBuf;π OpenFunc: IOFunc;π InOutFunc: IOFunc;π FlushFunc: IOFunc;π CloseFunc: IOFunc;π UserData: array[1..16] of Byte;π Name: array[0..79] of Char;π Buffer: TTextBuf;π end;ππfunction NextChar(var Source: text):char;πbeginπ NextChar := chr(0); { This is the default value in case ofπ error }π with TextRec(Source) doπ beginπ if BufPos >= BufEnd thenπ { Buffer empty; need to fill it }π InOutRes := InOutFunc(Source); { This sets the System errorπ variable InOutRes; other thanπ that, it ignores errors. }π NextChar := BufPtr^[BufPos] { A test here of whether aπ a character was availableπ would be a good idea }π end;πend;π 10 05-28-9313:46ALL SWAG SUPPORT TEAM NICECODE.PAS IMPORT 113 (*π>Does anyone know of a utility Program that will apply some sort ofπ>reasonable structuring to a pascal source File?ππI'm not sure if it's what you want, but the source For a PascalπreFormatter, etc, was entered in the Fidonet PASCAL ProgrammingπCompetition, and came third (I came second!!).ππAs you can see by the File dates, this is a very recent thing andπsince it is Nearly too late I toyed With the idea of just keeping itπto myself. It certainly is not an example of inspired Programming.πBut then, I thought, if everyone felt that way you'd have nothing toπchose from and even if this is not a prize winner, mayby someoneπelse will find it useful.ππSo here it is... not extensively tested, but I couldn't find anyπbugs. Used Pretty to reFormat itself and it still Compiled andπworked. Anyway, the only possible use is to another Turbo PascalπProgrammer who shouldn't have any difficult modifying to suitπhimself. They'd probably do that anyway since the output representsπmy own peculiar notion as to what a readable Format should be.ππ'Pretty Printers' date back to the earliest Computer days andπVariations existed For just about any language. However, I've beenπunable to find a current one For Turbo Pascal.ππHere's what this one does:ππPretty With no parameters generates a syntax message.ππInput is scanned line-by-line, Word-by-Word and Byte-by-Byte. Anyπidentifiers recognized as part of TP's language are replaced byπmixed Case (in a style which _I_ like). Someone else can editπConstants Borland1 through Borland5 and TP3. (Why TP3 later.) Theπfirst one on a line is capitalized anyway.ππA fallout of this is to use selected ones to determine indentationπin increments of 'IndentSpcs' which I arbitrarily set to 3. Changeπif you like. Indentation is incremented whenever one of theπ'IndentIDs' appears and decremented With 'UnindentIDs' (surprise!).ππSingle indents are also provided For 'SectionIDs' (Const, Type,πUses, Var) and For 'NestIDs' (Procedure Function) to make these moreπvisible. White space is what does it, right?ππOn the other hand, no attempt is made to affect white space in theπvertical direction. Since that generally stays the way youπoriginate it.ππAny '{', '(' or '''' (Single quote) detected during the line scanπtrigger a 'skipit' mode which moves the enclosed stuff directly toπoutput, unmodified. With one exception. {Comments} which begin aπline are aligned to the left margin (where I like to see Compilerπdirectives and one line Procedure/Function explanations). Otherπ{Comments} which begin/end on the same line are shifted so the '}'πaligns at the (80th column) right margin. I think this makes themπmore visible than when snuggled up to a semi-colon and getting themπaway from the code makes it more legible, too.ππand it did look better originally when it used some of my personalπUnits. Hastily modified to stand alone. There are, no doubt, someπobvious ways the Programming can be improved (you would probablyπhave used some nice hash tables to look up key Words) but, as I say,πI thought I would be the only one using this and speed in this Caseπis not all that important.ππWith one exception. Something I worked up For an earlierπapplication and may be worth looking at -- 'LowCase'.ππIt will Compile With TP4-TP5.5 and probably TP6 (if it stillπsupports Inline). I included TP3 stuff because some of the oldπsoftware I was looking at was written in it. and it recognizesπUnits in a clumsy sort of way.ππSwitching to chat mode here. if you're Really busy, you can skip theπfollowing.ππThis thing actually began as a 'Case-converter'. I was trying toπavoid re-inventing some wheels by re-working some old Pascal sourceπdating back to the late 70's and 80's. Upper Case Programs became aπ'standard' back in the days when you talked to main frames through aπteleType machine, which has no lower Case. Sadly, this persistedπlong after it was no longer necessary and I find thoseπall-upper-Case Programs almost unreadable. That is I can't findπwhat I'm looking For. They were making me crazy. (BTW I suspectπsome of this has to do With why Pascal has UpCase but no LoCase.)ππI stole the orginal LowCase included here from someone who had doneπthe intuitive thing -- first test For 'A', then For 'Z'. Changingπto an initial test For 'Z' does two things. A whopping 164 of theπ255 possible Characters can be eliminated With just one test and,πsince ordinary Text consists of mostly lower Case, these will beπpassed over rapidly.ππWhen you received this you thought, "Who the heck is Art Weller? Iπdon't remember him on the Pascal Echo." Right. I'm a 'lurker'!πBeen reading the echo since beFore it had a moderator. (Now we haveπan excellent one. Thank you.) I have a machine on a timer whichπcalls the BBS each morning to read and store several echos which Iπread later. Rarely get inspired enough to call back and enter aπdiscussion. Things usually get resolved nicely without me. Iπespecially don't want to get involved in such as the 'Goto' wars.πBut I monitor the better discussions to enhance my TP skills.ππI'm not Really a Programmer (no Formal training, that is --πComputers hadn't been invented when I was in school!), but anπengineer. I'm retired from White Sands Missile Range where I wasπChief of Plans and Programs For (mumble, mumble) years. Iπself-taught myself Computers when folks from our Analysis andπComputation Directorate started using jargon on me. I did that wellπenough to later help Write a book For people who wanted to convertπfrom BASIC to Pascal then after "retiring" was an editor For a smallπComputer magazine (68 Micro-Journal).ππIn summary, if you think this worth sharing With others I'll beπpleased enough even without a prize. not even sure it will getπthere in time. Snail-Mail, you know.π*)ππProgram Pretty;π{A 'Pretty Printer' For Turbo Pascal Programs}π{ This Program converts Turbo Pascal identifiers in a source code File toπ mixed Case and indents the code.π Released into Public Domain June, 1992 on an 'AS IS' basis. Enjoy at yourπ own risk.π Art Wellerπ 3217 Pagosa Courtπ El Paso, Texas 79904π U. S. A.π Ph. (915) 755-2516}ππ{Usesπ Strings;}ππConstπ IndentSpcs = 3;ππ Borland1 =π ' Absolute Addr and ArcTan Array Assign AuxInptr AuxOutptr BDos begin Bios '+π ' BlockRead BlockWrite Boolean Buflen Byte Case Chain Char Chr Close ClrEol '+π ' ClrScr Color Concat Const Copy Cos Delay Delete DelLine Dispose div do ';π Borland2 =π ' Downto Draw else end Eof Eoln Erase Execute Exp External False File '+π ' FilePos FileSize FillChar Flush For Forward Frac Freemem Function Getmem '+π ' Goto GotoXY Halt HeapPtr Hi HighVideo HiRes if Implementation in Inline ';π Borland3 =π ' Input Insert InsLine Int Integer Interface Intr IOResult KeyPressed '+π ' Label Length Ln Lo LowVideo Lst Mark MaxAvail Maxint Mem MemAvail Memw Mod '+π ' Move New Nil NormVideo not Odd of Ofs or Ord Output Overlay Packed ';π Borland4 =π ' Pallette Pi Plot Port Pos Pred Procedure Program Ptr Random Randomize Read '+π ' ReadLn Real Record Release Rename Repeat Reset ReWrite Round Seek Seg Set '+π ' Shl Shr Sin SizeOf Sound Sqr Sqrt Str String Succ Swap Text then to ';π Borland5 =π ' True Trunc Type Unit Until UpCase Uses UsrOutPtr Val Var While Window With '+π ' Write WriteLn xor ';π TP3 =π ' AUX CONinPTR CON CONOUTPTR ConstPTR CrtEXIT CrtinIT ERRorPTR Kbd '+π ' LStoUTPTR TRM USR USRinPTR ';ππ IndentIDs = ' begin Case Const Record Repeat Type Uses Var ';π UnIndentIDs = ' end Until ';π SectionIDs = ' Const Type Uses Var ';π endSection = ' begin Const Uses Var Function Implementation Interface '+π ' Procedure Type Unit ';π NestIDs = ' Function Procedure Unit ';ππ IDAlphas = ['a'..'z', '1'..'0', '_'];ππVarπ Indent,π endPend,π Pending,π UnitFlag : Boolean;π NestLevel,π NestIndent,π IndentNext,π IndentNow,π Pntr, LineNum : Integer;π IDs,π InFile,π OutFile,π ProgWrd,π ProgLine : String;π Idents,π OutID : Array [1..5] of String;π f1, f2 : Text;ππFunction LowCase(Ch: Char): Char;πbeginπ Inline(π $8A/$86/>Ch/ { mov al,>Ch[bp] ;Char to check}π $3C/$5A/ { cmp al,'Z' }π $7F/$06/ { jg Done }π $3C/$41/ { cmp al,'A' }π $7C/$02/ { jl Done }π $0C/$20/ { or al,$20 }π $88/$86/>LowCase); {Done :mov >LowCase[bp],al }πend;ππFunction LowCaseStr(InStr : String): String;πVarπ i : Integer;π len: Byte Absolute InStr;πbeginπ LowCaseStr[0] := Chr(len);π For i := 1 to len doπ LowCaseStr[i] := LowCase(InStr[i]);πend;ππFunction Blanks(Count: Byte): String; {return String of 'Count' spaces}πVarπ Result: String;πbeginπ FillChar(Result[1], Count+1, ' ');π Result[0] := Chr(Count);π Blanks := Result;πend;ππProcedure StripLeading(Var Str: String); {remove all leading spaces}πbeginπ While (Str[1] = #32) and (length(Str) > 0) doπ Delete(Str,1,1);πend;ππProcedure Initialize;πbeginπ IDs := IndentIDs + UnIndentIDs + endSection;π OutID[1] := Borland1;π Idents[1] := LowCaseStr(OutID[1]);π OutID[2] := Borland2;π Idents[2] := LowCaseStr(OutID[2]);π OutID[3] := Borland3;π Idents[3] := LowCaseStr(OutID[3]);π OutID[4] := Borland4;π Idents[4] := LowCaseStr(OutID[4]);π OutID[5] := Borland5 + TP3;π Idents[5] := LowCaseStr(OutID[5]);π Pending := False;π UnitFlag := False;π IndentNext := 0;π IndentNow := 0;π LineNum := 0;π NestIndent := 0;π NestLevel := 0;πend;ππProcedure Greeting;πbeginπ Writeln;π Writeln('Pascal Program Indenter');π Writeln; Writeln;π Writeln('SYNTAX: INDENT InputFile OutPutFile');π Writeln(' INDENT InputFile > OutPut');π Writeln; Writeln;π Halt(0);πend;ππProcedure OpenFiles;πbeginπ if paramcount <> 0 thenπ beginπ InFile := ParamStr(1);π if (pos('.', InFile) = 0) thenπ InFile := InFile + '.pas';π OutFile := Paramstr(2);π endπ elseπ Greeting;π Assign(f1, InFile);π Reset(f1);π Assign(f2, OutFile);π ReWrite(f2);πend;ππProcedure GetWord;πVarπ i,π index,π TmpPtr,π WrdPos : Integer;ππ Procedure DecIndent;π beginπ if (IndentNext > IndentNow) then {begin/end on same line}π Dec(IndentNext)π elseπ if IndentNow > 0 thenπ dec(IndentNow);π IndentNext := IndentNow; {next line, too}π end;ππbeginπ ProgWrd := ' ';π TmpPtr := Pntr;ππ While (LowCase(ProgLine[Pntr]) in IDAlphas) {Convert checked For LCase alpha}π and (Pntr <= length(ProgLine)) doπ beginπ ProgWrd := ProgWrd + LowCase(ProgLine[Pntr]);π Inc(Pntr);π end;ππ ProgWrd := ProgWrd+' '; {surrounded With blanks to make it unique!}π index := 0;ππ Repeat; {is it a Turbo Pascal Word?}π inc(index);π WrdPos := Pos(ProgWrd, Idents[index]);π Until (WrdPos <> 0) or (index = 5);ππ if WrdPos <> 0 then {found a Pascal Word}π beginπ Move(OutID[index][WrdPos+1], ProgLine[TmpPtr], Length(ProgWrd)-2);π if TmpPtr = 1 thenπ ProgLine[1] := UpCase(ProgLine[1]);ππ if Pos(ProgWrd, IDs) <> 0 then {only checked if a Pascal Word ^}π beginπ if Pos(ProgWrd, endSection) <> 0 then {this includes "SectionIDs"}π begin {and "NestIDs"}π if (pos(ProgWrd, NestIDs) <> 0) thenπ beginπ if ProgWrd = ' Unit ' thenπ UnitFlag := True;π if not UnitFlag thenπ inc(NestLevel);π end;π if Pending thenπ DecIndent;π Pending := Pos(ProgWrd, SectionIDs) <> 0;π if ProgWrd = ' Implementation ' thenπ UnitFlag := False;π end;π if Pos(ProgWrd, IndentIDs) <> 0 thenπ inc(IndentNext); {Indent 1 level}π if Pos(ProgWrd, UnIndentIDs) <> 0 thenπ beginπ DecIndent; {Unindent 1 level}π if (IndentNow = 0) and (NestLevel > 0) thenπ dec(NestLevel);π end;π if NestLevel > 1 thenπ NestIndent := 1;π end;π end;πend;ππProcedure Convert;ππ Procedure OutLine;π Varπ Tabs : String[40];π beginπ Tabs := Blanks((IndentNow+NestIndent) * IndentSpcs);π if ProgLine[1] = '{' thenπ Writeln(f2, ProgLine)π elseπ Writeln(f2, Tabs, ProgLine);π IndentNow := IndentNext; { get ready For next line }π if NestLevel < 2 thenπ NestIndent := 0;π end;ππ Procedure Skipto(SearchChar: Char);π beginπ Repeatπ if pntr > Length(ProgLine) thenπ beginπ OutLine;π Readln(f1, ProgLine); {get another line}π Pntr := 0;π end;π Inc(pntr);π Until (ProgLine[pntr] = SearchChar) or Eof(f1);π end;ππ Procedure MoveComments;π Varπ TmpIndent : Integer;π beginπ if (ProgLine[1] = '{') or (ProgLine[Pntr+1] = '$') thenπ beginπ Skipto('}');π Exit;π end;π TmpIndent := (IndentNow+NestIndent) * IndentSpcs;π While Length(ProgLine) < 80-TmpIndent doπ Insert(' ', ProgLine, Pntr);π While (pos('}', ProgLine) > 80-TmpIndent) and (pos(' {', ProgLine) > 1) doπ beginπ Delete(ProgLine, Pos(' {', ProgLine), 1);π Dec(Pntr);π end;π Skipto('}');π end;ππbeginπ While not Eof(f1) doπ beginπ Readln(f1, ProgLine);π StripLeading(ProgLine);π if Length(ProgLine) = 0 thenπ Writeln(f2)π elseπ beginπ Pntr := 1;π Repeatπ Case LowCase(ProgLine[pntr]) ofπ 'a'..'z','_' : GetWord;π '{' : MoveComments;π '(' : Skipto(')');π #39 : Skipto(#39) {Single quote}π end;π Inc(pntr)π Until (pntr >= length(ProgLine));π OutLine;π end;π end; { While }π Close(f1); Close(f2);πend;ππbeginπ Initialize;π OpenFiles;π Convert;πend.π 11 05-28-9313:46ALL SWAG SUPPORT TEAM SEARCH.PAS IMPORT 101 Program search; π{$A+,B-,D-,E+,F-,I+,L-,N-,O-,R-,S-,V-}π{$M 16384,0,655360}πππ { Copyright 1990 Trevor J Carlsen Version 1.05 24-07-90 }π { This Program may be used and distributed as if it was in the Public Domain}π { With the following exceptions: }π { 1. if you alter it in any way, the copyright notice must not be }π { changed. }π { 2. if you use code excerpts in your own Programs, due credit must be }π { given, along With a copyright notice - }π { "Parts Copyright 1990 Trevor J Carlsen" }π { 3. No Charge may be made For any Program using code from this Program.} ππ { SEARCH will scan a File or group of Files and report on all occurrences }π { of a particular String or group of Characters. if found the search String }π { will be displayed along With the 79 Characters preceding it and the 79 }π { Characters following the line it is in. Wild cards may be used in the }π { Filenames to be searched. }π π { if you find this Program useful here is the author's contact address - } π π { Trevor J Carlsen } π { PO Box 568 } π { Port Hedland Western Australia 6721 } π { Voice 61 [0]91 72 2026 } π { Data 61 [0]91 72 2569 } πππ πUsesπ Dos,π tpString, { Turbo Power's String handling library. Procedures and }π { Functions used from this Unit are - }π { BMSearch THESE ARE in THE SOURCE\MISC DIRECtoRY }π { BMSearchUC }π { BMMakeTable }π { StUpCase }π tctimer; { A little timing routine - not needed if lines (**) removed. }π πConstπ bufflen = 65000; { Do not increase this buffer size . Ok to decrease. }π searchlen = bufflen;π copyright1 = 'SEARCH - version 1.05 Copyright 1990 Trevor Carlsen';π copyright2 = 'All rights reserved.';ππTypeπ str79 = String[79];π bufferType = Array[0..bufflen] of Byte;π buffptr = ^bufferType;ππConstπ space = #32;π quote = #34;π comma = #44;π CaseSensitive : Boolean = True; { default is a Case sensitive search }πVarπ table : BTable; { Boyer-Moore search table }π buffer : buffptr; { Pointer to new buffer }π f : File;π DisplayStr : Array[0..3] of str79;π Filename,π SrchStr : String;π Slen : Byte Absolute SrchStr;π πProcedure Asc2Str(Var s, ns; max: Byte);ππ { Converts an Array of asciiz Characters to a turbo String }π { For speed the Variable st is effectively global and it is thereFore }π { vitally important that max is no larger than the ns unTyped parameter }π { Failure to ensure this can result in unpredictable Program behaviour }π π Var stArray : Array[0..255] of Byte Absolute s;π st : String Absolute ns;π len : Byte Absolute st;π π beginπ move(stArray[0],st[1],max);π len := max;π end; { Asc2Str }ππProcedure ReportError(e : Byte);π { Displays a simple instruction screen in the event of insufficient }π { parameters or certain other errors }π beginπ Writeln('SYNTAX:');π Writeln('SEARCH [-c] [path]Filename searchstr');π Writeln(' eg: SEARCH c:\comm\telix\salt.doc "color"');π Writeln(' or');π Writeln(' SEARCH c:\comm\telix\salt.doc 13,10,13,10,13,10,13,10');π Writeln(' or');π Writeln(' SEARCH -c c:\*.* "MicroSoft"');π Writeln;π Writeln('if the -c option is used then a Case insensitive search is used.');π Writeln('When used the -c option must be the first parameter.');π halt(e);π end; { ReportError }ππProcedure ParseCommandLine;π { This Procedure is Really the key to everything as it parses the command }π { line to determine what the String being searched For is. Because the }π { wanted String can be entered in literal Form or in ascii codes this will }π { disect and determine the method used. }π π Varπ parstr : String; { contains the command line }π len : Byte Absolute parstr;{ will contain the length of cmd line }π cpos, qpos,π spos, chval : Byte;π error : Integer;π π begin { ParseCommandLine}π parstr := String(ptr(PrefixSeg,$80)^); { Get the command line }π if parstr[1] = space thenπ delete(parstr,1,1); { if the first Character is a space get rid of it }π spos := pos(space,parstr); { find the first space }π if spos = 0 then { No spaces which must be an error }π ReportError(1); π π Filename := StUpCase(copy(parstr,1,spos-1)); { Filename used as a temp }π if pos('-C',Filename) = 1 then begin { Case insensitive search required }π CaseSensitive := False;π delete(parstr,1,spos); { Get rid of the used portion }π end; { if pos('-C' }π spos := pos(space,parstr); { find next space }π if spos = 0 then { No spaces which must be an error }π ReportError(1); π Filename := StUpCase(copy(parstr,1,spos-1)); { Get the File mask }π delete(parstr,1,spos); { Get rid of the used portion }π π qpos := pos(quote,parstr); { look For the first quote Char }π if qpos <> 0 then begin { quote Char found - so must be quoted Text }π if parstr[1] <> quote then ReportError(2); { first Char must be quote }π delete(parstr,1,1); { get rid of the first quote }π qpos := pos(quote,parstr); { and find the next quote }π if qpos = 0 then ReportError(3); { no more quotes - so it is an error }π SrchStr := copy(parstr,1,qpos-1); { search String now defined }π end { if qpos <> 0 }π π else begin { must be using ascii codes }π Slen := 0; π cpos := pos(comma,parstr); { find first comma }π if cpos = 0 then cpos := succ(len);{ No comma - so only one ascii code }π Repeat { create the search String }π val(copy(parstr,1,pred(cpos)),chval,error);π if error <> 0 then ReportError(7); { there is an error so bomb out }π inc(Slen);π SrchStr[Slen] := Char(chval); { add Char to the search String }π delete(parstr,1,cpos); { get rid of used portion of parstr }π cpos := pos(comma,parstr); { find the next comma }π if cpos = 0 then cpos := succ(len); { no more commas so last Char }π Until len = 0; { Until whole of command line is processed }π end; { else}π π if not CaseSensitive then { change the Search String to upper Case }π SrchStr := StUpCase(SrchStr);π end; { ParseCommandLine }ππFunction OpenFile(ofn : String): Boolean; { open a File For BlockRead/Write }π Varπ error : Word;π begin { OpenFile}π assign(f,ofn);π {$I-} reset(f,1); {$I+}π error := Ioresult;π if error <> 0 thenπ Writeln('Cannot open ',ofn);π OpenFile := error = 0;π end; { OpenFile }ππProcedure CloseFile;π beginπ {$I-}π Close(f);π if Ioresult <> 0 then; { don't worry too much if an error occurs here }π {$I+}π end; { CloseFile }ππProcedure SearchFile(Var Filename: String);π { Reads a File into the buffer and then searches that buffer For the wanted}π { String or Characters. }π Varπ x,y,π count,π result,π bufferpos : Word;π abspos : LongInt;π finished : Boolean;π π begin { SearchFile}π BMMakeTable(SrchStr,table); { Create a Boyer-Moore search table }π new(buffer); { make room on the heap For the buffers }π {$I-} BlockRead(f,buffer^,searchlen,result); {$I+} { Fill buffer buffer }π if Ioresult <> 0 then begin { error occurred While reading the File }π CloseFile;π ReportError(11);π end; { if Ioresult }π abspos := 0; { Initialise the Absolute File position marker }π Repeatπ bufferpos := 0; { position marker in current buffer }π count := 0; { offset from search starting point }π finished := (result < searchlen); { if buffer <> full no more reads }π π Repeat { Do a BM search For search String }π if CaseSensitive then { do a Case sensitive search }π count:=BMSearch(buffer^[bufferpos],result-bufferpos,table,SrchStr)π else { do a Case insensitive search }π count:=BMSearchUC(buffer^[bufferpos],result-bufferpos,table,SrchStr);π π if count <> $FFFF then begin { search String found }π inc(bufferpos,count); { starting point of SrchStr in buffer }π DisplayStr[0] := HexL(abspos+bufferpos) + { hex and decimal pos }π Form(' @######',(abspos+bufferpos) * 1.0);π if bufferpos > 79 then { there is a line available beFore }π Asc2Str(buffer^[bufferpos - 79],DisplayStr[1],79)π else { no line available beFore the found }π DisplayStr[1] := ''; { position so null the String }π if (bufferpos + 79) < result then { at least 79 Chars can be }π Asc2Str(buffer^[bufferpos],DisplayStr[2],79) { displayed }π else { only display what is left in buffer }π Asc2Str(buffer^[bufferpos],DisplayStr[2],result - bufferpos);π if (bufferpos + 158) < result then { display the line following }π Asc2Str(buffer^[bufferpos + 79],DisplayStr[3],79)π else { no line following the found String }π DisplayStr[3] := ''; { so null the display String }π Writeln;π Writeln(DisplayStr[0],' ',Filename);{ display the File locations }π π For x := 1 to 3 do beginπ For y := 1 to length(DisplayStr[x]) do{ filter out non-printables}π if ord(DisplayStr[x][y]) < 32 then DisplayStr[x][y] := '.';π if length(DisplayStr[x]) <> 0 then { only display Strings With }π Writeln(DisplayStr[x]); { valid content }π end; { For x }π π inc(bufferpos,Slen); { no need to check buffer in found st }π end; { if count <> $ffff }π π Until (bufferpos >= (result-length(SrchStr))) or (count = $ffff);π π if not finished then begin { Fill 'er up again For another round }π inc(abspos,result - Slen); { create overlap so no String missed }π {$I-} seek(f,abspos);π BlockRead(f,buffer^,searchlen,result); {$I+}π if Ioresult <> 0 then beginπ CloseFile;π ReportError(13);π end;π end; { if not finished}π Until finished;π dispose(buffer);π end; { SearchFile }ππProcedure SearchForFiles;π Varπ dirinfo : SearchRec;π FullName: PathStr;π DirName : DirStr;π FName : NameStr;π ExtName : ExtStr;π found : Boolean;π beginπ FindFirst(Filename,AnyFile,dirinfo);π found := DosError = 0;π if not found then beginπ Writeln('Cannot find ',Filename);π ReportError(255);π end;π FSplit(Filename,DirName,FName,ExtName);π While found do beginπ if (dirinfo.Attr and 24) = 0 then beginπ FullName := DirName + dirinfo.name;π if OpenFile(FullName) then beginπ SearchFile(FullName);π CloseFile;π end;π end;π FindNext(dirinfo);π found := DosError = 0;π end;π end; { SearchForFiles }ππbegin { main}π (**) StartTimer;π Writeln(copyright1);π Writeln(copyright2);π ParseCommandLine;π SearchForFiles;π (**) WriteElapsedTime;πend.ππ 12 05-28-9313:46ALL SWAG SUPPORT TEAM STRPOS.PAS IMPORT 23 π Hi, Andy:ππ ...Just for fun I also threw together a "PosSearch" routineπ that uses the built-in TP "POS" function. It actually performsπ better than I thought it would, as it takes a string longer thanπ 15 characters before it starts to become slower than the Boyer-π Moore function I just posted. (ie: PosSearch is faster than theπ Boyer-Moore routine for strings that are smaller than 16 chars)π Here's a demo program of the "PosSearch" search routine I putπ together. *Remember* to turn-off "range-checking" {$R-} in yourπ finished program, otherwise the PosSearch will take longer thanπ it should to execute.ππ (* Public-domain Search routine, using the standard TP *)π (* POS function. Guy McLoughlin - May 1, 1993. *)πprogram DemoPosSearch;πππ (***** PosSearch function. Returns 0 if string is not found. *)π (* Returns 65,535 if BufferSize is too large. *)π (* ie: Greater than 65,520 bytes. *)π (* *)π function PosSearch({input } var Buffer;π BuffSize : word;π Pattern : string) : {output} word;π typeπ arwo_2 = array[1..2] of word;π arch_255 = array[1..255] of char;π varπ po_Buffer : ^arch_255;π by_Temp,π by_IncSize : byte;π wo_Index : word;π beginπ if (BuffSize > 65520) thenπ beginπ PosSearch := $FFFF;π exitπ end;π wo_Index := 0;π by_IncSize := (255 - pred(length(Pattern)));π po_Buffer := addr(Buffer);π repeatπ by_Temp := pos(Pattern, po_Buffer^);π if (by_Temp = 0) thenπ beginπ inc(wo_Index, by_IncSize);π inc(arwo_2(po_Buffer)[1], by_IncSize)π endπ elseπ inc(wo_Index, by_Temp)π until (by_Temp <> 0) or (wo_Index > BuffSize);π if (by_Temp = 0) thenπ PosSearch := 0π elseπ PosSearch := wo_Indexπ end; (* PosSearch. *)πππtypeπ arby_64K = array[1..65520] of byte;ππvarπ Index : word;π st_Temp : string[20];π Buffer : ^arby_64K;ππBEGINπ new(Buffer);π fillchar(Buffer^, sizeof(Buffer^), 0);π st_Temp := '12345678901234567890';π move(st_Temp[1], Buffer^[65501], length(st_Temp));π Index := PosSearch(Buffer^, sizeof(Buffer^), st_Temp);π writeln(st_Temp, ' found at offset ', Index)πEND.ππ - Guyπ---π ■ DeLuxe²/386 1.25 #5060 ■π * Rose Media, Toronto, Canada : 416-733-2285π * PostLink(tm) v1.04 ROSE (#1047) : RelayNet(tm)ππ 13 05-28-9313:46ALL SWAG SUPPORT TEAM STSEARCH.PAS IMPORT 16 ┌─┬─────────────── Andy Stewart ───────────────┬─╖π│o│ Can someone tell/show me how to write a procedure that │o║π│o│ will take a string input and search for it in a textfile │o║π╘═╧══════════════════════════════════════════════════════════╧═╝π{ Simple example for a straight forward search routine }πvarπ f : text;π buf : array[0..maxint] of char;π line : word;π pattern,s,t : string;ππ{ Corrected version of routine from turbo techniques }πfunction uppercase (strg:string):string; assembler;πASMπ push dsπ lds si,strgπ les di,@resultπ cldπ lodsbπ stosbπ xor ch,chπ mov cl,alπ jcxz @doneπ @more:π lodsbπ cmp al,'a'π jb @noπ cmp al,'z'π ja @noπ sub al,20hπ @no:π stosbπ loop @moreπ @done:π pop dsπEND;ππ{ If you want the above routine in pascalπfunction uppercase (strg : string) : string;π var i : integer;π beginπ for i := 1 to length(strg) do strg[i] := upcase(strg[i]);π uppercase := strg;π end;π}ππprocedure search4pattern;π beginπ readln(f,s);π inc(line);π t := uppercase(s);π if pos(pattern,t) > 0π then writeln(line:5,' ',s);π end;ππbeginπ Line := 0;π if paramcount < 2 then exit;π pattern := paramstr(2);π pattern := uppercase(pattern);π assign(f,paramstr(1));π settextbuf(f,buf);π {$I-} reset(f); {$I+}π if ioresult = 0π then beginπ while not eof(f) do search4pattern;π close(f);π endπ else writeln('File not found');πend.π---π ■ Tags τ Us ■ Abandon the search for truth: settle on a good fantasy.π * Suburban Software - Home of King of the Board(tm) - 708-636-6694π * PostLink(tm) v1.05 SUBSOFT (#715) : RelayNet(tm) Hubππ 14 05-28-9313:46ALL SWAG SUPPORT TEAM SYMTAB1.PAS IMPORT 69 SYMBOL TABLEππ All Compilers and interpreters must maintain a data structureπ called the SYMBOL TABLE. This is where all the inFormation aboutπ the Programs symbols are kept. Maintaining a well-organizedπ symbol table is a skill all Compiler Writers must master.ππ As a Compiler parses a source Program, it relies on the symbolπ table to provide inFormation about each identifier (such asπ Variables and Constants) - it must be able to access and updateπ inFormation about each identifier and do so quickly - otherwiseπ the process is slowed or produces incorrect results.ππ No matter what inFormation is kept, or how the table is organizedπ certain operations are fundamental to a symbol tables operation.ππ You ENTER inFormation about about an identifier into the table byπ *creating* and entry.ππ You SEARCH the table to look up an identifier's entry and makeπ available the inFormation in that entry.ππ You UPDATE the entry to modify stored inFormation.ππ There can be only one entry per identifier in the symbol table,π so you must first search the table beFore making a new entry.ππ TABLE ORGANIZATIONππ There are many different ways to handle symbol tables: Arrays,π linked lists, hash tables...but since the most common operationsπ perFormed on a symbol table are searching it For existing entriesπ it makes perfect sense to implement it as a BINARY TREE.ππ Each NODE in the TREE contains and entry, and points to two otherπ nodes. The *values* of the nodes on the subtree to the left areπ always LESS than the parent node, While the subtree to the rightπ is always MORE than the parent. This makes searching sortedπ binary trees very efficient.ππ Inserting new nodes is as easy as searching the tree: if theπ value you want to insert is LESS than the current node, searchπ the node to the left. If it is MORE, search the tree to the right.π Keep doing this recursively Until an empty node is found, thenπ insert the value into that node.ππ NITTY-GRITTYππ Now that we've covered some background on the table, here's aπ recap on the symbol table Type defs. For those that missed themπ in the first message, or didn't save them:ππTypeπ sptr = ^String; { useful For minimum-size allocation }ππ DEFN_KEY = (UNDEFINED,π Const_DEFN, Type_DEFN, Var_DEFN, FIELD_DEFN,π VALPARM_DEFN, VarPARM_DEFN,π PROG_DEFN, PROC_DEFN, FUNC_DEFNπ );ππ ROUTINE_KEY = (rkDECLARED, rkForWARD,π rkREAD, rkREADLN, rkWrite, rkWriteLN,π rkABS, rkARCTAN, rkCHR, rkCOS, rkEOF, rkEOLN,π rkEXP, rkLN, rkODD, rkORD, rkPRED, rkROUND,π rkSIN, rkSQR, rkSQRT, rkSUCC, rkTRUNCπ );ππ RTN_BLOCK = Record {info about routine declarations}π key :ROUTINE_KEY;π parm_count,π total_parm_size,π total_local_size :Word;π parms, locals,π local_symtab :SYMTAB_PTR; {symbol tables of routine}π code_segment :sptr; {interpreter}π end;ππ DTA_BLOCK = Recordπ offset :Word;π Record_idp :SYMTAB_PTR;π end;ππ INFO_REC = Recordπ Case Byte ofπ 0:(Constant :VALUE); { literal value }π 1:(routine :RTN_BLOCK); { identifier is routine }π 2:(data :DTA_BLOCK); { identifier is data }π end;ππ DEFN_REC = Recordπ key :DEFN_KEY; { what is identifier? }π info :INFO_REC; { stuff about identifier }π end;ππ SYMTAB_PTR = ^SYMTAB_NODE;π SYMTAB_NODE = Record {actual tree node}π left, right :SYMTAB_PTR; {Pointers to left and right subtrees}π next :SYMTAB_PTR; {For chaining a node}π name :sptr; {identifier name String}π level, {nesting level}π co_index :Integer; {code Label index}π defn :DEFN_REC; {definition info}π end; { Record }ππ EXCERCISE #1ππ Implement a symbol table SEARCH routine, and a symbol table ENTERπ routine. Both routines must accept a Pointer to the root of theπ tree, and the name of the identifier you are working With, andπ must return a Pointer to the node that was found in the searchπ routine, or enters in the enter routine. If no node was found, orπ entered, the routines must return NIL.ππ The resulting symbol table should be a sorted tree.ππππ│ Implement a symbol table SEARCH routine, and a symbol table ENTERπ│ routine. Both routines must accept a Pointer to the root of theπ│ tree, and the name of the identifier you are working with, andπ│ must return a Pointer to the node that was found in the searchπ│ routine, or enters in the enter routine. If no node was found, orπ│ entered, the routines must return NIL.π│ The resulting symbol table should be a sorted tree.ππππFunction Enter(root: SymTab_Ptr; PidStr: spstr): SymTab_Ptr;π{ - inserts a new indetifier String PidStr in the symol table. }π{ - nil is returned if duplicate identifier is found. }πVarπ Ptemp: SymTab_Ptr;πbeginπ if (root <> nil) then { not a terminal node }π if (PidStr = root^.name) thenπ beginπ Enter := nil;π Exitπ endπ else { recursive insertion calls to either left or right sub-tree }π if (PidStr > root^.name) thenπ Enter(root^.right, PidStr)π elseπ Enter(root^.left, PidStr)π else { a terminal node }π beginπ new(Ptemp); { create a new tree leaf node }π Ptemp^.name := PidStr;π Ptemp^.left := nil;π Ptemp^.right := nilπ endπend; { Enter }πππFunction Search(root: SymTab_Ptr; PidStr: spstr): SymTab_Ptr;π{ - search For a certain identifier String PidStr in the symbol table. }π{ - returns nil if search faild. }πbeginπ While (root <> nil) and (PidStr <> root^.name) doπ if (PidStr > root^.name) then { search the right sub-tree }π root := root^.rightπ elseπ if (PidStr < root^.name) thenπ root := root^.left; { search the left sub-tree }π Search := root { return the node }πend;ππ{===========================================================================}ππComment:π What made you choose BINARY trees over AVL trees? With binary trees,π the structure may become degenerate (unbalanced) and, the routines forπ searching and insertion becomes inefficient.ππ>Comment:π> What made you choose BINARY trees over AVL trees? With binary trees,π> the structure may become degenerate (unbalanced) and, the routines forπ> searching and insertion becomes inefficient.ππ Glad you could join us!ππ I chose a binary tree because it's simple and easy to Write, alsoπ a degenerate tree isn't much of a concern, simply because it'sπ intended to hold only identifiers and Constants, not everyπ statement. :)ππ As long as it sorts the data as it inserts, it will work. Thisπ isn't, after all, a graduate "course". The intention is to teachπ people how compilers work and show interested parties how toπ understand and Write their own, if they're interested. This isπ YOUR compiler you're writing, if you want to implement an AVLπ tree, go ahead!ππ>Function Search(root: SymTab_Ptr; PidStr: spstr): SymTab_Ptr;ππ This works. It's efficient and does the job.ππ>Function Enter(root: SymTab_Ptr; PidStr: spstr): SymTab_Ptr;ππ> else { recursive insertion calls to either left or right sub-tree }π> if (PidStr > root^.name) thenπ> Enter(root^.right, PidStr)π> elseπ> Enter(root^.left, PidStr)ππ Note: recursive calls shouldn't be necessary in this Function.π You can search the table the same way you did With Search, andπ you don't run the risk of running out of stack space. Procedureπ calls can also be exensive, slowing down the Program too muchπ especially if a lot of symbols are searched.ππ> else { a terminal node }π> beginπ> new(Ptemp); { create a new tree leaf node }π> Ptemp^.name := PidStr;π> Ptemp^.left := nil;π> Ptemp^.right := nilπ> endπ>end; { Enter }ππ Please note that there is a lot of data that will be have toπ added to this section over time, as an identifier could beπ ANYTHING from a ConstANT to a Program identifier.ππ That isn't too important right now, as we're just getting startedπ on the symbol table but suggest you add the following lines, forπ use later:ππ Ptemp^.info := NIL;π Ptemp^.defn.key := UNDEFINED;π Ptemp^.level := 0; {recursion level}π Ptemp^.Label_index := 0; {Label # to be used in code output}π 15 05-28-9313:46ALL SWAG SUPPORT TEAM SYMTAB2.PAS IMPORT 27 LARRY HADLEYππ Errata: include an "info" Pointer field in the SYMTAB_NODEπ structure in the previous post.ππ USING THE SYMBOL TABLE - A CROSS REFERENCERππ A cross-reference is a listing of a Programs identifiers inπ alphabetical order:ππPage 1 hello.pas April 08 1993 19:03π 1 0: Program hello (output);π 2 0: Var i:Integer;π 3 0: beginπ 4 0: For i := 1 to 10 doπ 5 0: beginπ 6 0: WriteLn('Hello world.');π 7 0: end;π 8 0: end.ππCross Referenceπ---------------ππhello 1ππi 2 4ππInteger 2ππouput 1ππWriteln 6ππ As shown above, alongside each identifier's name are the sourceπ line numbers that contain the identifier. (This is useful forπ tracking where they're used)ππ A cross-referencer reads the source File and looks forπ identifiers, using the scanner you've built previously. The firstπ time a particular identifier is found, it is inserted in theπ symbol tree along With it's line number. Subsequent appearances ofπ the same identifier update the symbol tree With an additional lineπ number appended to the list of line numbers.ππ As soon as the Program is completely scanned, all the identifierπ names and their line numbers are printed.ππ Use the INFO field of SYMTAB_NODE to point to a LINKED LIST ofπ line numbers.ππ The main loop should scan For tokens Until it finds a period, orπ Exits With an "Unexpected end of File" error. For each identifier,π search the symbol table to see if their were any previousπ instances of the identifier. If it is not found, then this must beπ the first time it is used so we can call the "enter" Function toπ create a new node.ππ Then, whether a new node was actually created or not, we call aπ Function to add the line number to the queue of line numbersπ attached to the node's "info" field. Finally, when the scannerπ loop terminates, we call a printing Function which traverses theπ tree from left to right to print the sorted tree - and all theπ line numbers in the linked list attached to each node.ππ Note that a recursive call to itself is probably the easiest wayπ to do this, since _all_ the nodes of the tree are being accessed,π not just one.ππ Types you will need:ππTypeπ pLINENUMS = ^LINENUM_NODE;π LINENUM_NODE = Recordπ next :pLINENUMS;π line :Integer;π end;ππ pLINE_HEADER = ^LINENUM_HDR;π LINENUM_HDR = Recordπ first, last :pLINENUMS;π end;ππ EXCERCISE #1ππ Write a cross referencer, as above. Text it With an assortment ofπ pascal sourceFiles.ππ ADVANCED EXCERCISEππ Note that the symbol table above converts all identifier names toπ lower case. What would be needed to reWrite the scanner/xrefπ Program to preserve case? ReWrite the xref Program to do so. (noteπ that Pascal compilers are Case insensitive, so the symbol table -ππ For compatibility - must compare lower case)ππ "BRAIN TEASERS"ππ 1. What would be necessary to reWrite the symbol table as a hashπ table?ππ 2. If an identifier appears more than once in a line, lineπ numbers will appear more than once in the listing. Fix xref toπ recognize duplicate occurences of line numbers in node-lists.ππ -----------------------------------------------------------------ππ Next: Pascal source cruncher.π 16 05-28-9313:46ALL SWAG SUPPORT TEAM TAGLINES.PAS IMPORT 42 { BOB SWARTππHere it is, all new and much faster. I used an internal binary tree to manageπthe taglines. You can store up to the available RAM in taglines:π}ππ{$A+,B-,D-,E-,F-,G-,I-,L-,N-,O-,P-,Q-,R-,S+,T-,V-,X-}π{$M 16384,0,655360}πUsesπ Crt;πTypeπ TBuffer = Array[0..$4000] of Char;ππConstπ Title = 'TagLines 0.2 by Bob Swart For Travis Griggs'#13#10;π Usage = 'Usage: TagLines inFile outFile'#13#10#13#10+π ' Taglines will remove dupicate lines from inFile.'#13#10+π ' Resulting Text is placed in outFile.'#13#10;ππ NumLines: LongInt = 0; { total number of lines in InFile }π NmLdiv80: LongInt = 0; { NumLines div 80, For 'progress' }π CurrentL: LongInt = 0; { current lineno read from InFile }ππTypeπ String80 = String[80];ππ PBinTree = ^TBinTree;π TBinTree = Recordπ Info: String80;π left,right: PBinTreeπ end;ππVarπ InBuf,π OutBuf : TBuffer;π InFile,π OutFile : Text;π TagLine : String80;π Root,π Current,π Prev : PBinTree;π i : Integer;π SaveExit : Pointer;πππFunction CompStr(Var Name1,Name2: String): Integer; Assembler;π{ Author: drs. Robert E. Swartπ}πAsmπ push DSπ lds SI,Name1 { ds:si pts to Name1 }π les DI,Name2 { es:di pts to Name2 }π cldπ lodsb { get String1 length in AL }π mov AH,ES:[DI] { get String2 length in AH }π inc DIπ mov BX,AX { save both lengths in BX }π xor CX,CX { clear cx }π mov CL,AL { get String1 length in CX }π cmp CL,AH { equal to String2 length? }π jb @Len { CX stores minimum length }π mov CL,AH { of String1 and String2 }π @Len: jcxz @Exit { quit if null }ππ @Loop: lodsb { String1[i] in AL }π mov AH,ES:[DI] { String2[i] in AH }π cmp AL,AH { compare Str1 to Str2 }π jne @Not { loop if equal }π inc DIπ loop @Loop { go do next Char }π jmp @Exit { Strings OK, Length also? }ππ @Not: mov BX,AX { BL = AL = String1[i],π BH = AH = String2[i] }π @Exit: xor AX,AXπ cmp BL,BH { length or contents comp }π je @Equal { 1 = 2: return 0 }π jb @Lower { 1 < 2: return -1 }π inc AX { 1 > 2: return 1 }π inc AXπ @Lower: dec AXπ @Equal: pop DSπend {CompStr};ππProcedure Stop; Far;πbeginπ ExitProc := SaveExit;π Close(InFile);π Close(OutFile);πend {Stop};πππbeginπ Writeln(Title);π if Paramcount <> 2 thenπ beginπ Writeln(Usage);π Haltπ end;ππ Assign(InFile,ParamStr(1));π SetTextBuf(InFile,InBuf);π Reset(InFile);π if IOResult <> 0 thenπ beginπ WriteLn('Error: could not open ', ParamStr(1));π Halt(1)π end;ππ Assign(OutFile,ParamStr(2));π SetTextBuf(OutFile,OutBuf);π Reset(OutFile);π if IOResult = 0 thenπ beginπ WriteLn('Error: File ', ParamStr(2),' already exists');π Halt(2)π end;ππ ReWrite(OutFile);π if IOResult <> 0 thenπ beginπ WriteLn('Error: could not create ', ParamStr(2));π Halt(3)π end;ππ SaveExit := ExitProc;π ExitProc := @Stop;ππ While not eof(InFile) doπ beginπ readln(InFile);π Inc(NumLines);π end;π Writeln('There are ',NumLines,' lines in this File.'#13#10);π Writeln('Press any key to stop the search For duplicate lines');π NmLdiv80 := NumLines div 80;ππ Root := nil;π reset(InFile);π While CurrentL <> NumLines doπ beginπ if KeyPressed thenπ Halt { calls Stop };π Inc(CurrentL);π if (CurrentL and NmLdiv80) = 0 thenπ Write('#');π readln(InFile,TagLine);ππ if root = nil then { first TagLine }π beginπ New(Root);π Root^.left := nil;π Root^.right := nil;π Root^.Info := TagLine;π Writeln(OutFile,tagLine)π endπ else { binary search For TagLine }π beginπ Current := Root;π Repeatπ Prev := Current;π i := CompStr(Current^.Info,TagLine);π if i > 0 thenπ Current := Current^.leftπ elseπ if i < 0 thenπ Current := Current^.rightπ Until (i = 0) or (Current = nil);ππ if i <> 0 then { TagLine not found }π beginπ New(Current);π Current^.left := nil;π Current^.right := nil;π Current^.Info := TagLine;ππ if i > 0 thenπ Prev^.left := Current { Current before Prev }π elseπ Prev^.right := Current { Current after Prev };π Writeln(OutFile,TagLine)π endπ endπ end;π Writeln(#13#10'100% Completed, result is in File ',ParamStr(2))π { close is done by Stop }πend.ππ{π> I also tried DJ's idea of the buffer of 65535 but it said the structureπ> was too large. So I used 64512.πAlways try to use a multiple of 4K, because the hard disk 'eats' space in theseπchunks. Reading/Writing in these chunks goes a lot faster that way.π}
